home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / util / binsort.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  823 b   |  33 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. (* binsort.sml *)
  3.  
  4. structure BinSort = struct
  5.  
  6. datatype 'a tree = NIL
  7.          | NODE of {left : 'a tree ref, right : 'a tree ref, value : 'a ref}
  8.  
  9. fun mkSortTree () = ref NIL
  10.  
  11. fun insert (op >, tree) v =
  12.     let fun insert' tr =
  13.         case !tr of
  14.           NIL => tr := NODE{left=ref NIL, right=ref NIL, value=ref v}
  15.         | NODE{left, right, value} =>
  16.         if !value > v then insert'(left)
  17.         else if v > !value then insert'(right)
  18.         else value := v
  19.     in insert'(tree)
  20.     end
  21.  
  22. exception Finished
  23.  
  24. fun generator (tree) =
  25.     let val LCS = ref(fn()=>raise Match)
  26.     fun loop (NIL,k) = k()
  27.       | loop (NODE{left,right,value},k) =
  28.         loop (!left,fn()=>(LCS := (fn()=>loop(!right,k)); !value))
  29.     in (LCS := (fn()=>loop(tree,fn()=>raise Finished)); fn()=> !LCS())
  30.     end
  31.  
  32. end (* BinSort *)
  33.